home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 44 / Amiga Format CD44 (1999-08-26)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-10].iso / -in_the_mag- / basics / hisoft / octetpurge.lha / OctetPurge / OctetPurge.bas < prev    next >
BASIC Source File  |  1998-07-09  |  4KB  |  180 lines
  1. REM Octet Purger 1.2 by Simon N Goodwin, December 1997.
  2. REM Updated February 1998 to fix the 'NOT Copying' bug.
  3. REM Updated July 1998 to strip base64 sections as well.
  4. REM
  5. REM WHAT?
  6. REM
  7. REM Program to scan MIME a mail file and remove all
  8. REM octet-stream binary encoded or "Content-Transfer-
  9. REM Encoding: base64" data sections.
  10. REM
  11. REM REQUIREMENTS
  12. REM
  13. REM Written in HiSoft BASIC. Requires ASL library.
  14. REM Uses 15 point Helvetica.font if it's available.
  15. REM
  16. REM WHY?
  17. REM
  18. REM Written to keep the size of archived YAM mail
  19. REM manageable, on the basis that binary contents
  20. REM ought to be archived somewhere else already.
  21. REM
  22. REM HOW?
  23. REM 
  24. REM Start from Workbench by clicking on the icon.
  25. REM Select a file to be scanned or CANCEL to quit.
  26. REM Repeat selection for each file to be purged.
  27. REM
  28. REM Input file is not modified. A new file on the
  29. REM same path with the suffix ".purged" is created
  30. REM containing the original contents except with
  31. REM the 'application octet-stream' nad base64
  32. REM data sections replaced with the text:
  33. REM
  34. REM     **** Encoded binary deleted from archive.
  35. REM
  36. REM KNOWN BUGS
  37. REM
  38. REM No check that the output file name is valid.
  39. REM No diagnostics if the input file is malformed.
  40. REM
  41. REM In HiSoft BASIC, NOT 1 = TRUE! This stopped
  42. REM the first release copying the first part of
  43. REM the file. This was fixed in version 1.1.
  44. REM
  45. REM
  46. REM STATUS
  47. REM
  48. REM Freely distributable; you must include source.
  49. REM
  50. REM AUTHOR
  51. REM
  52. REM Simon N Goodwin, simon@studio.woden.com
  53. REM
  54.  
  55. DEFINT a-z
  56.  
  57. ' HiSoft ASL library and disk font initialisation
  58.  
  59. REM $INCLUDE diskfont.bh
  60. REM $INCLUDE graphics.bh
  61. REM $include asl.bh
  62. LIBRARY OPEN "asl.library"
  63. LIBRARY OPEN "diskfont.library"
  64. LIBRARY OPEN "graphics.library"
  65.  
  66. WINDOW 1,"  MIME Mail archive file Octet Purger v1.2  ", _
  67.     (32,16)-(608,160),1+2+4+16+256
  68.  
  69. REM Use a groovier Compugraphic fo(u)nt if you wish
  70.  
  71. DIM TextAttr(4)
  72. InitTextAttr TextAttr(),"Helvetica.font",15,0,0
  73. font& = OpenDiskFont (VARPTR(TextAttr(0)))
  74.  
  75. IF font&
  76.   SetFont WINDOW (8), font&
  77. ELSE
  78.   PRINT " **** Preferred font not available. Using default."
  79. END IF
  80.  
  81. pattern$="Content-Type: application/octet-stream"
  82. pattern2$="Content-Transfer-Encoding: base64"
  83. patlen=LEN(pattern$)
  84. patlen2=LEN(pattern2$)
  85.  
  86. boundary$="--BOUNDARY"
  87. boundlen=LEN(boundary$)
  88.  
  89. ' ASL requester initialisation
  90.  
  91. CONST TAG_DONE&=0,TRUE&=1,ABORT&=-1,FALSE&=0
  92. DIM frtags&(20)
  93.  
  94. ' Main program
  95.  
  96. ok=TRUE
  97.  
  98. REPEAT main
  99.     
  100.     TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&, _
  101.         "Select the file to be purged", _
  102.         ASLFR_InitialFile&,"", _
  103.         ASLFR_InitialDrawer&,"RAM:", _
  104.         ASLFR_InitialHeight&,     130, _
  105.         ASLFR_InitialLeftEdge&, 280, _
  106.         ASLFR_InitialWidth&,         310, _ 
  107.         TAG_DONE&
  108.         
  109.     fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
  110.     IF fr& THEN
  111.         ok&=AslRequest&(fr&,0)
  112.         IF ok& THEN
  113.             file$=PEEK$(PEEKL(fr&+fr_File))
  114.             dir$=PEEK$(PEEKL(fr&+fr_Drawer))
  115.             IF LEN(dir$)
  116.                 suffix$=RIGHT$(dir$,1)
  117.                 IF suffix$<>"/" AND suffix$<>":" THEN dir$=dir$+"/"
  118.             END IF
  119.         END IF
  120.         FreeASlRequest fr&
  121.     ELSE
  122.         ok&=ABORT&
  123.     END IF
  124.  
  125.   IF ok&=FALSE& OR ok&=ABORT& THEN EXIT main
  126.  
  127.   file$=dir$+file$
  128.   
  129.     PRINT
  130.  
  131.     OPEN file$ FOR INPUT AS #3
  132.     OPEN file$+".purged" FOR OUTPUT AS #4
  133.  
  134.     copying=1 : found=0
  135.  
  136.     REPEAT scan
  137.       IF EOF(3) THEN EXIT scan
  138.       INPUT #3,a$
  139.       IF copying=0
  140.         copying=LEFT$(a$,boundlen)=boundary$
  141.       END IF
  142.       IF LEFT$(a$,patlen)=pattern$ OR LEFT$(a$,patlen2)=pattern2$
  143.         IF LEFT$(a$,patlen2)=pattern2$
  144.           a$=p$
  145.         ELSE
  146.           PRINT #4,a$
  147.         END IF
  148.         PRINT " Purging: ";a$
  149.         PRINT #4
  150.         PRINT #4,"**** Encoded binary deleted from archive."
  151.         PRINT #4
  152.         copying=0: found=found+1
  153.       END IF
  154.       IF copying THEN PRINT #4,a$ :REM debug PRINT a$
  155.       p$=a$ ' 1.2 - Save previous line for BASE64 report
  156.     END REPEAT scan 
  157.  
  158.     CLOSE #4
  159.     CLOSE #3
  160.  
  161.     PRINT
  162.     PRINT " OK,";found;"binary stream";
  163.     IF found<>1 THEN PRINT "s";
  164.     PRINT " found in ";file$
  165.     PRINT
  166.     PRINT " Condensed version written to ";file$+".purged"
  167.     
  168. END REPEAT main
  169.  
  170. SYSTEM
  171.  
  172. SUB InitTextAttr(T(1),FontName$,BYVAL Height,BYVAL style,BYVAL flags)
  173.  
  174. POKEL VARPTR(T(0))+ta_Name,SADD(FontName$+CHR$(0))
  175. t(ta_YSize\2)=Height
  176. POKEB VARPTR(T(0))+ta_Style,style
  177. POKEB VARPTR(T(0))+ta_Flags,flags
  178.  
  179. END SUB ' InitTextAttr
  180.